home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr48
/
srtkit11.zip
/
MERGSORT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-04-15
|
9KB
|
281 lines
(******************************************************************************
* mergSort *
* this unit defines a merge sort object that sorts a file of a fixed length *
* using merge sort. *
******************************************************************************)
unit mergSort;
interface
{$I-}
type
mergeSortPtr = ^mergeSort;
mergeSort = object
fileName : string; { the original name of the file we manipulate }
mergFile : file; { this is the file we read, and sort ... }
blokSize : word; { the block size we are interested in ...}
block1,
block2 : pointer;{ pointers to blocks beeing compared }
tempPath : string; { temporary files path }
fileSize : longInt;{ size of file in records ... }
t1, t2,
t3, t4 : file; { temporary files used during sort .. }
telem : longInt; { No of records in a telem ... }
outputNm : string; { the name of the output sorted file }
constructor init( fn : string; { file name }
bs : word; { block size }
tp : string; { temp path }
on : string { outfile name }
);
destructor done; virtual;
procedure doYourJob; virtual; { perform the merge sort }
function compare : byte; virtual;
{ compare block1, block2 , 0 eq, 1 (1 > 2), 2 (2 > 1) }
function splitFile : longInt; virtual;
function mergeFiles(tSize : longInt) : longInt;
{ perform one pass of merge with telem of tSize from t1,2 to t3,4 }
end; { mergeSort object ... }
implementation
(******************************************************************************
* mergeSort.init *
******************************************************************************)
constructor mergeSort.init;
begin
if (tp[length(tp)] <> '\') then
tp := tp + '\';
tempPath := tp;
fileName := fn;
blokSize := bs;
outputNm := on;
end; {mergeSort.init}
(******************************************************************************
* mergeSort.done *
******************************************************************************)
destructor mergeSort.done;
begin
close(t1);
close(t2);
close(t3);
close(t4);
end; {mergeSort.done}
(******************************************************************************
* mergeSort.compare *
* method override by user - sort descendant. *
******************************************************************************)
function mergeSort.compare;
begin
end; {mergeSort.compare}
(******************************************************************************
* mergeSort.doYourJob *
* here the actual sort is performed. *
******************************************************************************)
procedure mergeSort.doYourJob;
var
i : byte;
begin
assign(mergFile, fileName);
reset(mergFile, blokSize);
i := ioResult;
if (not (i in [0, 100, 103])) then
exit; { error occured, no sort is performed }
fileSize := splitFile; { create temp1 and temp2 files from mergFile, count records in file }
{ initial telem size is set in the splitFile procedure }
while (telem < fileSize) do
telem := mergeFiles(telem);
rename(t1, outputNm);
erase(t2);
end; {mergeSort.doYourJob}
(******************************************************************************
* mergeSort.splitFile *
******************************************************************************)
function mergeSort.splitFile;
var
i : longInt;
exitSplit : boolean;
writeTo1 : boolean;
begin
writeTo1 := true;
i := 0;
exitSplit := false;
assign(t1, tempPath + 'mrgsrtt1.$$$');
rewrite(t1, blokSize);
if (ioResult <> 0) then
exitSplit := true;
assign(t2, tempPath + 'mrgsrtt2.$$$');
rewrite(t2, blokSize);
if (ioResult <> 0) then
exitSplit := true;
getmem(block1, blokSize);
while ((not exitSplit) and (not eof(mergFile))) do begin
blockRead(mergFile, block1^, 1);
if (writeTo1) then
blockWrite(t1, block1^, 1)
else
blockWrite(t2, block1^, 1);
writeTo1 := not writeTo1;
inc(i);
end;
close(mergFile);
close(t1);
close(t2);
splitFile := i;
freeMem(block1, blokSize);
telem := 1;
end; {mergeSort.splitFile}
(******************************************************************************
* mergeSort.mergeFiles *
******************************************************************************)
function mergeSort.mergeFiles;
var
endMerge : boolean;
writePtr : pointer;
writeTot3: boolean;
newTelem : boolean;
t1Telem,
t2Telem : longInt;
i : byte;
procedure doWrite(writePtr : pointer);
begin
if (writeTot3) then
blockWrite(t3, writePtr^, 1)
else
blockWrite(t4, writePtr^, 1);
end; { doWrite }
procedure flushBlock2;
begin
if (t2Telem = 0) then
exit;
doWrite(block2);
inc(t2Telem);
while ((t2Telem <= tSize) and (not eof(t2))) do begin
blockRead(t2, block2^, 1);
inc(t2Telem);
doWrite(block2);
end;
{ rest of code to flush block 2 }
end;
procedure flushBlock1;
begin
if (t1Telem = 0) then
exit;
doWrite(block1);
inc(t1Telem);
while ((t1Telem <= tSize) and (not eof(t1))) do begin
blockRead(t1, block1^, 1);
inc(t1Telem);
doWrite(block1);
end;
{ rest of code to flush block 1 }
end;
begin
mergeFiles := 0; { 0 indicates an error, there is no such telem size }
assign(t3, tempPath + 'mrgsrtt3.$$$');
rewrite(t3, blokSize);
i := ioResult;
if (not (i in [0, 100, 103])) then
exit;
assign(t4, tempPath + 'mrgsrtt4.$$$');
rewrite(t4, blokSize);
i := ioResult;
if (not (i in [0, 100, 103])) then
exit;
assign(t1, tempPath + 'mrgsrtt1.$$$');
reset(t1, blokSize);
i := ioResult;
if (not (i in [0, 100, 103])) then
exit;
assign(t2, tempPath + 'mrgsrtt2.$$$');
reset(t2, blokSize);
i := ioResult;
if (not (i in [0, 100, 103])) then
exit;
getMem(block1, blokSize);
getMem(block2, blokSize);
getMem(writePtr, blokSize);
writeTot3 := true; { start writing to 3, so we will have 1 as the final one .. }
endMerge := false;
t1Telem := 1;
t2Telem := 1;
blockRead(t1, block1^, 1);
blockRead(t2, block2^, 1);
newTelem := false;
while (not endMerge) do begin
if (compare = 2) then begin { block2 is bigger, write block 1 first }
inc(t1Telem);
move(block1^, writePtr^, blokSize);
doWrite(writePtr);
if ((not eof(t1)) and (t1Telem <= tSize)) then
blockRead(t1, block1^, 1)
else begin
newTelem := true;
flushBlock2;
end;
end else begin
inc(t2Telem);
move(block2^, writePtr^, blokSize);
doWrite(writePtr);
if ((not eof(t2)) and (t2Telem <= tSize)) then
blockRead(t2, block2^, 1)
else begin
newTelem := true;
flushBlock1;
end;
end; { compare = 0, or 1 }
if (newTelem) then begin
writeTot3 := not writeTot3; { next telem written to other file }
newTelem := false;
if (not eof(t1)) then begin
blockRead(t1, block1^, 1);
t1Telem := 1;
end else
t1Telem := 0; { we finished t1, flush t2 if neccessary .. }
if (not eof(t2)) then begin
blockRead(t2, block2^, 1);
t2Telem := 1;
end else
t2Telem := 0; { we finished t1, flush t2 if neccessary .. }
if (t1Telem = 0) then begin
flushBlock2; { flushBlock2 does nothing if t2Telem is 0 ! }
endMerge := true;
end;
if (t2Telem = 0) then begin
flushBlock1; { flushBlock1 does nothing if t1Telem is 0 ! }
endMerge := true;
end;
end; { newTelem }
end; { while not endmerge .. }
close(t1);
close(t2);
close(t3);
close(t4);
erase(t1);
erase(t2);
rename(t3, tempPath + 'mrgsrtt1.$$$');
rename(t4, tempPath + 'mrgsrtt2.$$$');
freeMem(block1, blokSize);
freeMem(block2, blokSize);
freeMem(writePtr, blokSize);
mergeFiles := 2 * tSize;
end; {mergeSort.mergeFiles}
(******************************************************************************
* MAIN *
******************************************************************************)
end.